home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
5
/
dates.zip
/
DATES.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1987-10-27
|
5KB
|
198 lines
{$R-,S+,I-,D-,T-,F-,V-,B-,N-}
unit Dates;
{ A unit providing Julian day numbers and date manipulations.
Version 1.00 - 10/26/1987 - First general release
Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve 72247,2671 }
interface
const BlankDate = $FFFF; { Constant for Not-a-real-Date }
type Date = Word;
Day = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
function ValidDate(Day,Month,Year: integer): boolean;
{ Check if the day,month,year is a real date storable in a Date variable }
procedure DMYtoDate(Day,Month,Year: integer;var Julian: Date);
{ Convert from day,month,year to a date }
procedure DateToDMY(Julian: Date;var Day,Month,Year: integer);
{ Convert from a date to day,month,year }
function BumpDate(Julian: Date;Days,Months,Years: integer): Date;
{ Add (or subtract) the number of days, months, and years to a date }
function DayOfWeek(Julian: Date): Day;
{ Return the day of the week for the date }
function DayString(WeekDay: Day): string;
{ Return a string version of a day of the week }
function MonthString(Month: integer): string;
{ Return a string version of a month }
function DateToStr(Julian: Date): string;
{ Convert a date to a sortable string }
function StrToDate(StrVar: string): Date;
{ Convert a sortable string form to a date }
implementation
function ValidDate(Day,Month,Year: integer): boolean;
{ Check if the day,month,year is a real date storable in a Date variable }
begin
if (Day<1) or (Year<1900) or (Year>2078)
then
ValidDate := false
else
case Month of
1,3,5,7,8,10,12: ValidDate := Day <= 31;
4,6,9,11: ValidDate := Day <= 30;
2: ValidDate := Day <= 28 + ord((Year mod 4)=0)*ord(Year<>1900)
else ValidDate := false
end
end;
procedure DMYtoDate(Day,Month,Year: integer;var Julian: Date);
{ Convert from day,month,year to a date }
{ Stored as number of days since January 1, 1900 }
{ Note that no error checking takes place in this routine -- use ValidDate }
begin
if (Year=1900) and (Month<3)
then
if Month = 1
then
Julian := pred(Day)
else
Julian := Day + 30
else
begin
if Month > 2
then
dec(Month,3)
else
begin
inc(Month,9);
dec(Year)
end;
dec(Year,1900);
Julian := (1461*longint(Year) div 4) + ((153*Month+2) div 5) + Day + 58
end
end;
procedure DateToDMY(Julian: Date;var Day,Month,Year: integer);
{ Convert from a date to day,month,year }
var LongTemp: longint;
Temp: integer;
begin
if Julian <= 58
then
begin
Year := 1900;
if Julian <= 30
then
begin
Month := 1;
Day := succ(Julian)
end
else
begin
Month := 2;
Day := Julian - 30
end
end
else
begin
LongTemp := 4*longint(Julian) - 233;
Year := LongTemp div 1461;
Temp := LongTemp mod 1461 div 4 * 5 + 2;
Month := Temp div 153;
Day := Temp mod 153 div 5 + 1;
inc(Year,1900);
if Month < 10
then
inc(Month,3)
else
begin
dec(Month,9);
inc(Year)
end
end
end;
function BumpDate(Julian: Date;Days,Months,Years: integer): Date;
{ Add (or subtract) the number of days, months, and years to a date }
{ Note that months and years are added first before days }
{ Note further that there are no overflow/underflow checks }
var Day: integer;
Month: integer;
Year: integer;
begin
DateToDMY(Julian,Day,Month,Year);
Month := Month + Months - 1;
Year := Year + Years + (Month div 12) - ord(Month<0);
Month := (Month + 12000) mod 12 + 1;
DMYtoDate(Day,Month,Year,Julian);
BumpDate := Julian + Days
end;
function DayOfWeek(Julian: Date): Day;
{ Return the day of the week for the date }
begin
DayOfWeek := Day(succ(Julian) mod 7)
end;
function DayString(WeekDay: Day): string;
{ Return a string version of a day of the week }
const DayStr: array[Sunday..Saturday] of string[9] =
('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
begin
DayString := DayStr[WeekDay]
end;
function MonthString(Month: integer): string;
{ Return a string version of a month }
const MonthStr: array[1..12] of string[9] =
('January','February','March','April','May','June','July','August','September','October','November','December');
begin
MonthString := MonthStr[Month]
end;
function DateToStr(Julian: Date): string;
{ Convert a date to a sortable string }
const Result: record
case integer of
0: (Len: byte;
W: word);
1: (Str: string[2])
end = (Str:' ');
begin
Result.W := swap(Julian);
DateToStr := Result.Str
end;
function StrToDate(StrVar: string): Date;
{ Convert a sortable string form to a date }
var Temp: record
Len: byte;
W: word
end absolute StrVar;
begin
StrToDate := swap(Temp.W)
end;
end.